﻿Imports System.Drawing.Imaging
Imports System.Drawing
Public Class Draw
    Private tmpBMP As Bitmap
    Public Property ImageSource1 As Bitmap
    Public Property ImageSource2 As Bitmap
    Private _OutputImage As Bitmap
    Private X() As Integer = New Integer() {-1, -1, 0, 1, 1, 1, 0, -1}
    Private Y() As Integer = New Integer() {0, -1, -1, -1, 0, 1, 1, 1}
    Public Function DrawShadow(ByVal B As Bitmap) As Bitmap
        Dim PI As Double = 3.14159265358
        Dim tBs As New Bitmap(B.Width, B.Height)
        Using G As Graphics = Graphics.FromImage(tBs)
            G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
            Using tB As New Bitmap(SetOpacity(B, 0.01))
                For J As Integer = 2 To 180 Step 10
                    For I As Integer = 5 To 1 Step -1
                        G.DrawImage(tB, New Rectangle(I * Math.Cos(J), I * Math.Sin(J), tB.Width, tB.Height), New Rectangle(0, 0, tB.Width, tB.Height), GraphicsUnit.Pixel)
                    Next
                Next
            End Using
            G.DrawImage(B, New Point(0, 0))
            Return tBs
        End Using
    End Function
    Private Function SetOpacity(ByVal B As Bitmap, ByVal D As Double) As Bitmap
        Try
            Dim bmpDATA As New BitmapData
            If tmpBMP IsNot Nothing Then tmpBMP.Dispose()
            tmpBMP = New Bitmap(B)
            Dim Rct As Rectangle = New Rectangle(0, 0, B.Width, B.Height)
            bmpDATA = tmpBMP.LockBits(Rct, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
            Dim BTS(bmpDATA.Stride * bmpDATA.Height) As Byte
            Runtime.InteropServices.Marshal.Copy(bmpDATA.Scan0, BTS, 0, BTS.Length - 1)
            Dim T As Double = 0
            For I As Integer = 0 To BTS.Length - 4 Step 4
                BTS(I + 0) = 0
                BTS(I + 1) = 0
                BTS(I + 2) = 0
                T = BTS(I + 3)
                T = T * D
                BTS(I + 3) = T
            Next
            Runtime.InteropServices.Marshal.Copy(BTS, 0, bmpDATA.Scan0, BTS.Length - 1)
            tmpBMP.UnlockBits(bmpDATA)
            Return tmpBMP
        Catch
            Return Nothing
        End Try
    End Function
    Public Function MakeTransparentImage(ByVal value As Integer) As Bitmap
        Try
            Dim W As Integer = ImageSource1.Width
            Dim H As Integer = ImageSource1.Height
            value = IIf(value <= 0, 0, value)
            value = IIf(value >= W, W, value)
            If _OutputImage IsNot Nothing Then _OutputImage.Dispose()
            _OutputImage = New Bitmap(W, H)
            Using G As Graphics = Graphics.FromImage(_OutputImage)
                G.DrawImage(ImageSource1, New Rectangle(value, 0, W - value, H), New Rectangle(value, 0, W - value, H), GraphicsUnit.Pixel)
                G.DrawImage(ImageSource2, New Rectangle(0, 0, value, H), New Rectangle(0, 0, value, H), GraphicsUnit.Pixel)
            End Using
            Return _OutputImage
        Catch
            Return Nothing
        End Try
    End Function
    Public Sub DrawTextOutLine(ByVal c As Color, ByRef G As Graphics, ByVal S As String, ByVal Sf As StringFormat, ByVal Ft As Font, ByVal Sz As Size)
        For I As Integer = 0 To X.Length - 1
            G.DrawString(S, Ft, New SolidBrush(c), New Rectangle(X(I), Y(I), Sz.Width, Sz.Height), Sf)
        Next
    End Sub

    Public Function GetWeekICON() As Icon
        Try
            Select Case Now.Date.DayOfWeek
                Case DayOfWeek.Monday
                    Return My.Resources.M1
                Case DayOfWeek.Tuesday
                    Return My.Resources.M2
                Case DayOfWeek.Wednesday
                    Return My.Resources.M3
                Case DayOfWeek.Thursday
                    Return My.Resources.M4
                Case DayOfWeek.Friday
                    Return My.Resources.M5
                Case DayOfWeek.Saturday
                    Return My.Resources.M6
                Case DayOfWeek.Sunday
                    Return My.Resources.M7
                Case Else
                    Return 设置.Icon
            End Select
        Catch
            Return 设置.Icon
        End Try
    End Function
    Public Function GetWeekString() As String
        Try
            Select Case Now.Date.DayOfWeek
                Case DayOfWeek.Monday
                    Return "星期一"
                Case DayOfWeek.Tuesday
                    Return "星期二"
                Case DayOfWeek.Wednesday
                    Return "星期三"
                Case DayOfWeek.Thursday
                    Return "星期四"
                Case DayOfWeek.Friday
                    Return "星期五"
                Case DayOfWeek.Saturday
                    Return "星期六"
                Case DayOfWeek.Sunday
                    Return "星期日"
                Case Else
                    Return ""
            End Select
        Catch
            Return ""
        End Try
    End Function
    ''' <summary>
    ''' 建立快捷方式
    ''' </summary>
    ''' <param name="ShortcutName">快捷方式名称</param>
    ''' <param name="targetfilepath">快捷方式指向的目标程序</param>
    ''' <param name="IconLocation">图标路径</param>
    ''' <param name="Description">图标说明</param>
    ''' <param name="WorkingDirectory">工作路径</param>
    ''' <param name="CreateTo">要将快捷方式创建到的路径</param>
    ''' <param name="CreateToDesktop">是否创建到桌面</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function CreateShortcut(ByVal ShortcutName As String, ByVal targetfilepath As String, ByVal IconLocation As String, ByVal Description As String, Optional ByVal WorkingDirectory As String = "c:\", Optional ByVal CreateTo As String = "", Optional ByVal CreateToDesktop As Boolean = True) As Integer
        Try
            Dim wsh As Object = CreateObject("WScript.Shell")
            Dim desk As String = wsh.SpecialFolders("Desktop")
            If CreateToDesktop = False Then
                If CreateTo.Length <> 0 Then
                    desk = CreateTo
                End If
            End If
            Dim lnk As Object = wsh.CreateShortcut(desk & "\" & ShortcutName & ".lnk")
            With lnk
                .Arguments = ""
                .Description = Description
                .IconLocation = IconLocation
                .TargetPath = targetfilepath
                .WorkingDirectory = IIf(WorkingDirectory.Length <> 0, WorkingDirectory, "c:\")
                .Save()
            End With
            Return 0
        Catch
            Return 1
        End Try
    End Function
End Class

